### Salience Theory (Bordalo et al., 2012) function library
## Appendix Theory: A.4.4

MaxLikeSR_salience_LOO_crossVal = function(data, sub_sample, init){
  # Leave-one-out Cross Validation (LOO CV)
  start <- Sys.time()  
  data = sample_SR(data,sub_sample)
  index = data$studentID                                                            
  data = split(data,f = index)  
  
  dfs_LOOCV = lapply(data, LOOCV_train_test_split)
  results = lapply(dfs_LOOCV, LOO_crossVal_train_predict_salience, init)
  delta_coef = unlist(lapply(results, {function(x) mean(x[["delta.coef"]])}), use.names = FALSE)
  delta_coef_std = unlist(lapply(results, {function(x) sqrt(var(x[["delta.coef"]]))}), use.names = FALSE)
  score = unlist(lapply(results, {function(x) sum(x$accuracy)}), use.names = FALSE)
  results_scores = as.data.frame(cbind(studentID = unique(index), score = score, delta_mean = delta_coef,
                                       delta_std = delta_coef_std))
  
  print("Salience Theory - Leave-One-Out Test Accuracy Summary:")
  print(paste("Average:", mean(results_scores$score)))
  print(paste("Standard error:", sqrt(var(results_scores$score)/length(results_scores$score))))
  
  end = Sys.time()                                                                  
  timer = difftime(end,start,units = "secs")
  print(paste("Time taken for MLE algorithim and Cross-Validation:",seconds_to_period(round(timer[[1]],2))))
  return(list(estimations = results, summary = results_scores))
}



LOOCV_train_test_split = function(data){
  result = list()
  for(i in 1:length(data$qnum)){
    test_df = data[i, ]
    train_df = data[-i, ]
    result[[i]] <- list(train = train_df, test = test_df)
  }
  result
}



LOO_crossVal_train_predict_salience = function(LOO_train_test_folds, init){
  results = bind_rows(lapply(LOO_train_test_folds, LOO_train_test_salience, init))
  results
}



LOO_train_test_salience = function(train_test_dfs, init){
  train_df = train_test_dfs[["train"]]
  test_df = train_test_dfs[["test"]]
  
  results = wrapMLE_salience(train_df, init, log_lik_salience)
  results_summary = stat_sum_salience(results)
  results_summary$studentID = test_df$studentID
  
  param = list(delta = results_summary$delta.coef)
  test_predict_results = LOO_test_predict_salience(test_df, param, calc_util_salience)
  results_summary = cbind(results_summary, test_qnum = test_df$qnum, test_choice = test_df$choice, test_predict_results)
  results_summary
}





LOO_test_predict_salience = function(test_df, param, util_fun){
  lottery_data = list(l1 = list(prob = test_df[["prob.1"]], lower = test_df[["lower.1"]], upper = test_df[["upper.1"]]),
                      l2 = list(prob = test_df[["prob.2"]], lower = test_df[["lower.2"]], upper = test_df[["upper.2"]]),
                      l3 = list(prob = test_df[["prob.3"]], lower = test_df[["lower.3"]], upper = test_df[["upper.3"]]),
                      l4 = list(prob = test_df[["prob.4"]], lower = test_df[["lower.4"]], upper = test_df[["upper.4"]]),
                      l5 = list(prob = test_df[["prob.5"]], lower = test_df[["lower.5"]], upper = test_df[["upper.5"]]))
  
  lottery_utility = unlist(lapply(lottery_data, util_fun, param, test_df[["qnum"]]))
  predicted_choice = unname(which.max(lottery_utility))
  accuracy = if_else(predicted_choice == test_df$choice, 1, 0)
  list(pred_choice = predicted_choice, accuracy = accuracy)
}



calc_util_salience = function(df, param, qnum){
  if(qnum<=6 | qnum>=19 & qnum<=24){
    salience_value_func_1(df[["prob"]], df[["upper"]], df[["lower"]], param[["delta"]])
  }
  else if(qnum>=7 & qnum<=12 | qnum>=25 & qnum<=30){
    salience_value_func_2(df[["prob"]], df[["upper"]], df[["lower"]], param[["delta"]])
  }
  else{
    salience_value_func_3(df[["prob"]], df[["upper"]], df[["lower"]], param[["delta"]])
  }
}


salience_value_func_1 = function(prob, upper, lower, delta){
  #questions 1-6 and 19-24
  ((prob)/(prob + delta*(1-prob)))*upper + ((delta*(1-prob))/(prob + delta*(1-prob)))*lower
}


salience_value_func_2 = function(prob, upper, lower, delta){
  #questions 7-12 and 25-30
  ((delta*prob)/(delta*prob + (1-prob)))*upper + ((1-prob)/(delta*prob + (1-prob)))*lower
}


salience_value_func_3 = function(prob, upper, lower, delta){
  #questions 13-18 and 31-36
  (prob/(prob + (1-prob)))*upper + ((1-prob)/(prob + (1-prob)))*lower
}



wrapMLE_salience = function(data,init,logLikFun){
  salience_MaxLike_res = mle2(minuslogl = logLikFun, data = list(data=data), start = init,
                             method="L-BFGS-B", optimizer = "optim",
                             lower = c(delta=0.0001), upper = c(delta=1))
  salience_MaxLike_res
}





stat_sum_salience = function(stat){
  results = data.frame("studentID"=NA,"delta.coef"=NA,
                       "std.delta"=NA,"p.val.delta"=NA,
                       "logLikelihood"=NA,"AIC"=NA)
  summary = summary(stat)
  results["studentID"]  = NA
  results["delta.coef"]  = summary@coef[1,1]
  results["std.delta"]   = summary@coef[1,2]
  results["p.val.delta"] = summary@coef[1,4]
  results["logLikelihood"] = logLik(stat)
  results["AIC"]  = AIC(stat)
  return(results)
}



log_lik_salience <- function(delta, data){
  
  #calculating denominator of likelihood of a choice
  denomCalc = function(data, delta){
    qnum = data[["qnum"]]
    if(qnum<=6 | qnum>=19 & qnum<=24){calc_denom_salience_1(data, delta)}
    else if(qnum>=7 & qnum<=12 | qnum>=25 & qnum<=30){calc_denom_salience_2(data, delta)}
    else {calc_denom_salience_3(data, delta)}
  }
  
  denomRes = apply(data, 1, denomCalc, delta) #vector of denominator components for each student
  
  # calculate numerator of likelihood of a choice
  numerCalc = function(data, delta){
    qnum = data[["qnum"]]
    if(qnum<=6 | qnum>=19 & qnum<=24){calc_numer_salience_1(data, delta)}
    else if(qnum>=7 & qnum<=12 | qnum>=25 & qnum<=30){calc_numer_salience_2(data, delta)}
    else {calc_numer_salience_3(data, delta)}
  }
  
  numerRes = apply(data, 1, numerCalc, delta)
  
  #calculating log likelihood
  log_lik_i <-  log(numerRes/denomRes)

  -sum(unlist(log_lik_i))
}



calc_denom_salience_1 = function(data, delta){
  #questions 1-6 and 19-24
  exp(salience_value_func_1(data[["prob.1"]], data[["upper.1"]], data[["lower.1"]], delta)) +
  exp(salience_value_func_1(data[["prob.2"]], data[["upper.2"]], data[["lower.2"]], delta)) +
  exp(salience_value_func_1(data[["prob.3"]], data[["upper.3"]], data[["lower.3"]], delta)) +
  exp(salience_value_func_1(data[["prob.4"]], data[["upper.4"]], data[["lower.4"]], delta)) +
  exp(salience_value_func_1(data[["prob.5"]], data[["upper.5"]], data[["lower.5"]], delta)) 
}


calc_denom_salience_2 = function(data, delta){
  #questions 7-12 and 25-30
  exp(salience_value_func_2(data[["prob.1"]], data[["upper.1"]], data[["lower.1"]], delta)) +
  exp(salience_value_func_2(data[["prob.2"]], data[["upper.2"]], data[["lower.2"]], delta)) +
  exp(salience_value_func_2(data[["prob.3"]], data[["upper.3"]], data[["lower.3"]], delta)) +
  exp(salience_value_func_2(data[["prob.4"]], data[["upper.4"]], data[["lower.4"]], delta)) +
  exp(salience_value_func_2(data[["prob.5"]], data[["upper.5"]], data[["lower.5"]], delta)) 
}


calc_denom_salience_3 = function(data, delta){
  #questions 13-18 and 31-36
  exp(salience_value_func_3(data[["prob.1"]], data[["upper.1"]], data[["lower.1"]], delta)) +
  exp(salience_value_func_3(data[["prob.2"]], data[["upper.2"]], data[["lower.2"]], delta)) +
  exp(salience_value_func_3(data[["prob.3"]], data[["upper.3"]], data[["lower.3"]], delta)) +
  exp(salience_value_func_3(data[["prob.4"]], data[["upper.4"]], data[["lower.4"]], delta)) +
  exp(salience_value_func_3(data[["prob.5"]], data[["upper.5"]], data[["lower.5"]], delta)) 
}


calc_numer_salience_1 = function(data, delta){
  j = data[["choice"]]
  numercalc = exp(salience_value_func_1(prob = data[[13+j]], upper = data[[8+j]], lower = data[[3+j]], delta = delta))
  numercalc
}


calc_numer_salience_2 = function(data, delta){
  j = data[["choice"]]
  numercalc = exp(salience_value_func_2(prob = data[[13+j]], upper = data[[8+j]], lower = data[[3+j]], delta = delta))
  numercalc
}


calc_numer_salience_3 = function(data, delta){
  j = data[["choice"]]
  numercalc = exp(salience_value_func_3(prob = data[[13+j]], upper = data[[8+j]], lower = data[[3+j]], delta = delta))
  numercalc
}



sample_SR = function(data,sub_sample){
  if(sub_sample == "full"){data = data}
  if(sub_sample == "part1"){data = data %>% filter(qnum<19)}
  if(sub_sample == "part2"){data = data %>%  filter(qnum>18)}
  return(data)
}
















